#!/usr/bin/env perl
# Time-stamp: <12 Nov 04 15:27:01 giron1>

=head1 NAME

speech2sphere.perl - converts speech files to sphere format

=head1 SYNOPSIS

speech2sphere.perl [commands] [options] I<corpus>

see also:

L<"COMMANDS">,
L<"OPTIONS">

at the end of this document.

=head1 DESCRIPTION

This script converts speech files from a defined location (normally
the cdrom server) to sphere format.

=head1 SEE ALSO

The following packages description:

L<OPTIONS>,
L<GLOBALS>,
L<SAM2ESPS>

=head1 AUTHOR

  $Id: speech2sphere.perl,v 1.1 2007/10/08 09:26:03 schweitz Exp $
  Franck Giron

=head1 LOG

  $Log: speech2sphere.perl,v $
  Revision 1.1  2007/10/08 09:26:03  schweitz
  version 2.4, lib vergessen

  Revision /main/18  18-Nov-2004.15:27:47  giron1
  Corrected search path for sound files. Dependent of utr_dir updated.
  
  Revision /main/17  17-Jan-2003.12:25:53  giron1
  Updating header to /usr/bin/env perl.
  
  Revision 1.16  2000/09/26 16:19:20  giron1
  Change of Path to string
  
  Revision 1.15  2000/05/29 14:31:53  giron1
  some extra my suppressed
  
  Revision 1.14  2000/04/27 16:02:24  giron1
  Pod documentation updated
  

=cut

#----------------------------------------------------------------------
# perl packages
#----------------------------------------------------------------------

use strict;
use FileHandle;
use File::Copy;
use File::Path;
use File::Basename;

use myFind;
use Misc;
use GLOBALS;
use OPTIONS;
use SAM2ESPS;

#----------------------------------------------------------------------

=head1 FUNCTIONS 

Here are the different functions

=head2 findext

finds an extension from a channel list. This function was written to
cope with swapped channel in the scenario1 fra recorded at Sony France
where the Zenographics card has a bug.

=cut

sub findext{
  
  my ($extwished,$chanext,$name,$chanlist) = @_;
  
  my $ext;
  # check if the file belong to the channel list
  my $inchanlist = grep /$name/, @$chanlist;
  # yes
  if ($inchanlist) {
    # Do we want the left channel (C38B mic) ?
    if ($extwished eq 'lch') {$ext = ($chanext eq 'lch') ? 'rch' : 'lch';} 
    # or the right channel (navi mic) ?
    else {$ext = $chanext;}
  }								# no
  else {
    # Do we want the left channel (C38B mic) ?
    if ($extwished eq 'lch') {$ext = $chanext;}
    # or the right channel (navi mic) ?
    else {$ext = ($chanext eq 'lch') ? 'rch' : 'lch';}
  }
  return $ext;
}

=head2 ProcessList

  This function is the core of the speech files conversion
  
  The following variables have to be defined in the calling routine
  $opt_l    : The list of options coming from the argument list
  $path_db  : The path for the current database
  $ext_l    : The list of file extensions valid for the speech files
  of the current database
  $corp     : The corpus name

=cut

#----------------------------------------------------------------------

sub ProcessList{
  my ($opt_l,$path_db,$ext_l,$corp) = @_;
  my ($pattern);
  my ($fh,$filein);
  my ($orig_header_size,$toconvert);
  my ($bytes_before_header_size,$nist_header_size,$orig_size,$nist_size);
  
  # test if the corpus belongs to STC standard
  my $stcstandard = grep(/$corp/,@GLOBALS::STC_FORMAT_CORPUS_LIST);
  
  # test if the sound directory is existing
  my $dsound = $opt_l->{dsound}{string} . $path_db;
  if (not $stcstandard and not -d $dsound ) {
    warn "Sound directory $dsound not existent\n";
    return -1;
  }
  
  # Test if the list name option has been given
  my $listd = $opt_l->{ldir}{string};
  my $listname = $listd;
  if ($opt_l->{lname}{string} ne '') {$listname .= $opt_l->{lname}{string};}
  # if not then list name is defined as equal to the database directory
  else {$listname .= $path_db; $listname =~ s/\/$//;}
  $listname .= $opt_l->{elist}{string};
  
  my $format = $opt_l->{'format'}{string};
  my $samp_freq = $opt_l->{samp}{string};
  
  warn "listd:$listd\n";
  warn "path_db:$path_db\n";
  warn "listname: $listname\n";
  warn "$corp $format sampling: $samp_freq -> $opt_l->{snist}{string}\n";
  
  # Open the files list
  if (not -r $listname ) {warn "$listname not existent\n"; return -1;}
  my $fList = new FileHandle "<$listname";
  die "$0: Error by opening $listname\n" unless (defined($fList));
  my @list = map {chop $_; $_ } <$fList>;
  $fList->close;
  
  warn "list $listname has :",$#list+1," entries\n";
  
  my @rootlist = ();
  if ($stcstandard) {
    # Search possible roots
    if ($opt_l->{rpat}{string} ne '') {
      @rootlist = realpath($opt_l->{rpat}{string},$opt_l->{dsound}{string});
    }
  }
  
  # create the complete output database path
  my $dirout = $opt_l->{dbdir}{string} . $opt_l->{lang}{string} . '/' . $path_db . '/';
  mkpath($dirout,1) unless (-d $dirout);
  
  # generate output filenames hash
  my %fout_h = ();
  my ($id,$s_root,$s_name,$s_suffix,$rootmatch);
  my $idprec = '';
  my $s_prec = '';
  my ($basein,$basename);
  foreach $basename (@list) {
	
    my $fileout = $opt_l->{dbdir}{string} . $basename . '.'. $opt_l->{enist}{string};
	
    # if nistfile exists and not zero that's fine
    next if (-r $fileout and !-z $fileout );
	
    # Determine search root and name
    $basein = $basename;
    $basein =~ s/$opt_l->{lang}{string}\///;
    ($s_name,$s_root,$s_suffix) = fileparse($basein);
    
    if ($stcstandard) {
      # check for original database
      # Determine speaker ID number
      $s_root =~ m/(\w+)\/$/; $id = $1;
      if ($id ne $idprec) {
		$idprec = $id;
		# determine real root path from location list
		$rootmatch = 0;
		if (defined($opt_l->{loc}{Root}{$id})) {
		  $s_root = $opt_l->{dsound}{string} . $opt_l->{loc}{Root}{$id};
		  $rootmatch = -d "$s_root/$id";
		}						# or from roots list
		else {
		  foreach $s_root (@rootlist) {$rootmatch = -d "$s_root/$id";last if ($rootmatch);}
		}
		if ($rootmatch) {
		  $s_prec = "$s_root/$id";
		  # determine the list of all existing files in the common directory
		  my $dircommon = $s_root . '/common/';
		  if (-d $dircommon) {
			warn "s_root= $s_root, dircommon = $dircommon \n";
			my $filenames = find(\&wanted,'.*',$dircommon);
			# and copy them
			foreach (@$filenames) {
			  $filein = $_;
			  s/$s_root/$dirout/;
			  if (-d dirname($filein)) {mkpath(dirname($_),1);}
			  if (-f $filein and not -f $_) {
				warn $filein,'->',$_,"\n";
				copy $filein, $_;
			  }
			}
		  }
		  # search in the speaker directory for *.sif files
		  $basein = "$s_root/$id";
		  if (-d $basein) {
			warn "search for rif,sif files in $basein\n";
			my $filenames = find(\&wanted,'.*\.\w+if', $basein);
			# and copy them
			foreach (@$filenames) {
			  $filein = $_;
			  s/$s_root/$dirout/;
			  if (-d dirname($filein)) {mkpath(dirname($_),1);}
			  if (-f $filein and not -f $_) {
				warn $filein, ' ->', $_,"\n";
				copy $filein, $_;
			  }
			}
		  }
		} else {
		  warn "$s_root/$id not matched\n";
		  if ($s_prec eq $s_root) {warn "Error: check your location or pattern for $id!!\n";}
		}
      }
    }							# not stc standard
    else {
      if ($s_root ne $s_prec) {
		$basein = $opt_l->{dsound}{'string'} . $s_root;
		$rootmatch = -d $basein;
		$s_prec = $s_root;
      }
    }
    if ($rootmatch) {
	  $fout_h{$s_prec . '/'. $s_name} = $fileout;
    }
  }
  
  my @kfout_h = sort keys %fout_h;
  return if ($#kfout_h lt 0);
  
  # Create temporary conversion parameter file for esps
  my $tmpconv = '/tmp/' . $$ . '.sfconvert_param';
  
  if ( !-f $tmpconv) {
    open TMPPAR, ">$tmpconv";
    print TMPPAR "int start=1;\nint nan=0;\n";
    close TMPPAR;
  }
  
  # process each file of the list
  $idprec = '';
  my $baseprec = '';
  my @chanlist = ();
  
  foreach $basename (@kfout_h) {
    my $fileout = $fout_h{$basename};
    warn "$basename->$fileout\n";
    # Test if the data base belong to STC standard
    if ($stcstandard) {
      # Determine search root and name
      ($s_name,$s_root,$s_suffix) = fileparse($basename);
      # Determine speaker ID number
      $s_root =~ m/([^\/]*)\/$/;
      $id = $1;
      warn "s_root= $s_root, s_name =$s_name ,id = $id, idprec=$idprec\n";
      # extract channel speaker infos
      # only if the id number changes
      if ($id ne $idprec) {
		$idprec = $id;
		$baseprec = $basename;
		@chanlist = ();
		if (defined($opt_l->{chan}{Id}{$id})) {
		  my $chanfile = $opt_l->{ldir}{string} . "chanlist/$id.list"; 
		  $fh = new FileHandle;
		  $fh->open("<$chanfile") || die "cannot open $chanfile\n";
		  @chanlist = <$fh>;
		  $fh->close;
		} else {warn "No channel file for $id\n";}
      }
    }
	
    # Find the input files with the correct extensions
	
	# do we have stc standard
    if ($stcstandard) {
	  # check if the channel extension list has some content
	  if ($#chanlist ge 0) {
		my $chanext = $opt_l->{chan}{Id}{$id};
		$filein = $basename . '.' . findext($ext_l->[0],$chanext,$s_name,\@chanlist);
	  }
	  # check if the extension list given as argument has more than one argument
      if ($#{$ext_l}) {
		$pattern = "$s_name\\\." . join("|$s_name\\\.", @{$ext_l} );
	  }
	  else {
		$pattern = $s_name . '.' . $ext_l->[0];
	  }
#	  # check for the presence of UTR directory
#	  my $utr_dir = undef;
#	  if (defined($GLOBALS::UTR_DIR)) {
#		$utr_dir = $GLOBALS::UTR_DIR;
#	  }
#	  # this option overwrite the preceding one
#	  if (exists($GLOBALS::CORPUS_H->{$corp}{utr_dir})) {
#		$utr_dir = $GLOBALS::CORPUS_H->{$corp}{utr_dir};
#	  }
#	  # search now for potential directory matching this
#	  if (defined($utr_dir)) {
#		my $dirin_list = find(\&wanted,$utr_dir,$s_root);
#		my $search_root = $dirin_list->[0];
#	  }
	  
	  my $filein_list = find(\&wanted,$pattern,$s_root);
	  $filein = $filein_list->[0];
    }
	# not stc standard
	else {
	  $filein = $basename . '.' . $ext_l->[0];
	}
	
    # if $filein exists create nistfile, if it does not exist check for out file
    if ( ! -r $filein ) {
      warn "$filein not readable\n";
      if ( -r $fileout ) {
		if ( -z  $fileout ) {
		  warn "$fileout has ZERO size\n"; next;
		}
		warn "$fileout was earlier $::DONE_MESSAGE\n"; next;
      }
      warn "$fileout not readable\n"; next;
    }
    if ( -z $filein) {
      warn "$filein has ZERO size !\n"; next;
    }
	
    # Create directories if necessary
    mkpath(dirname($fileout),1) unless (-d dirname($fileout));
    # Convert file
  SWITCH:{
      if ($format eq 'nistshort') {
		open(FILE,"< $filein") or die "cannot open: $filein\n";
		my $header = <FILE>;
		if ($header =~ /NIST/) {
		  my $tmp = <FILE>;
		  chop $tmp;
		  $orig_header_size = int $tmp;
		} else {die "$filein is not a NIST file\n";}
		close(FILE);
		last SWITCH;
      }
      if ($format eq 'raw') {
		$orig_header_size = 0;
		last SWITCH;
      }
      if ($format eq 'stc') {
		$orig_header_size = 0;
		last SWITCH;
      }
      if ($format eq 'phondat') {
		$orig_header_size = 0;
		$bytes_before_header_size = 23;
		$fh = new FileHandle "< $filein";
		if (defined $fh ) {
		  read $fh, $orig_header_size, 2, $bytes_before_header_size;
		  $fh->close;
		}
      }
      die "Error: File format $format unknown\n";
    }
	
    my $tmp1 = '/tmp/' . $$ . '.speech-1';
    my $tmp2 = '/tmp/' . $$ . '.speech-2';
	
    if ( $opt_l->{no_swab}{Do} ) {
      if ($orig_header_size and $samp_freq != $opt_l->{snist}{string}) {
		system("dd bs=512 if=$filein of=$tmp1 skip=$orig_header_size ");
		$toconvert = $tmp1;
      } else {$toconvert = $filein;}
    }
    else {
      warn "swapping bytes of $filein\n";
      system("dd bs=512 conv=swab if=$filein of=$tmp1 skip=$orig_header_size ");
      $toconvert = $tmp1;
    }
	
  SWITCH:{ 
      my @com = split('', $0);
      my $com = $0;
      if ($samp_freq != $opt_l->{snist}{string}) {
		system("./sampconv2nist.csh $tmpconv $samp_freq $opt_l->{snist}{string} $toconvert $fileout");
		last SWITCH;
      } 
      else {
		if ($format eq 'nistshort') {
		  my $shorten = '/home/rapp/shatr/shorten-2.2/shorten';
		  system("$shorten -x -d $orig_header_size $toconvert $tmp1");
		  chmod 0664, "$tmp1";
		  $toconvert = $tmp1;
		}
		my $espsc = 'check_for_esps_license 60 5 ';
		system("$espsc btosps -f $samp_freq -c $com $toconvert $tmp2");
		system("$espsc e2sphere $tmp2 $fileout");
		
		last SWITCH;
      }
    }
	
    # Check file size
    $fh = new FileHandle "< $fileout";
    if (defined $fh) {
      my $t = <$fh>;
      $nist_header_size = <$fh>;
      $fh->close;
    } else {die "Error: $fileout not defined\n";}
	
    if ( $format eq 'vm' ) {
      $orig_header_size = 512 * $orig_header_size;
    }
    $orig_size = -s $filein;
    $orig_size -= $orig_header_size;
    $orig_size = int $orig_size * $opt_l->{snist}{string} / $samp_freq;
    $nist_size = -s $fileout;
    $nist_size -= $nist_header_size;
    my $MaxByteError = int $samp_freq / $opt_l->{snist}{string};
    unless ( $orig_size-$MaxByteError <= $nist_size and $nist_size <= $orig_size+$MaxByteError
			 or $format eq 'nistshort') {
      warn "original size = $orig_size, nist size = $nist_size\n";
      die "Error: $filein: wrong file size after conversion\n";
    }
    if ( $bytes_before_header_size and $orig_header_size <= $bytes_before_header_size ) {
      warn "original header size = $orig_header_size\n";
      die "Error: $filein: wrong header size before or after conversion\n";
    }
    warn "$fileout $::DONE_MESSAGE\n";
  }
  unlink $tmpconv;
}

#----------------------------------------------------------------------

=head2 wanted

This subroutine is used to match a pattern in the find program

  The following variables have to be defined in the calling routine
  $pat      : The search pattern
  $list     : The resulting list

=cut

sub wanted {
  my ($pat,$list) = @_;
  my ($name);
  
  if (m/^(?:$pat)$/i) {
	$name = $myFind::name;
	push @{$list}, $name;
  }
}

#----------------------------------------------------------------------

=head2 realpath

This subroutine is used to find a real path from a given pattern

=cut

sub realpath {
  my ($pattern,$root) = @_;
  
  # Determines the list of all existing directory entries
  opendir(DIR,$root) || (warn "Can't open $root: $!\n", return -1);
  my @dirs = sort readdir(DIR);
  closedir(DIR);
  
  # Find those matching the pattern
  my @paths = grep m/$pattern/i, @dirs;
  return @paths;
}

#----------------------------------------------------------------------

sub define_options {
  my ($corp,$opt,$popt) = @_;
  
  # Database directory
  $opt->define($popt,'dbdir',$GLOBALS::DBROOT,"<dir>\t: speech database directory");  
  
  # Sound sampling frequency
  $opt->define($popt,'samp',$GLOBALS::CORPUS_H->{$corp}{samp_freq},
			   "<freq>\t: sampling frequency of corpus speech files");
  
  # Lists directory
  $opt->define($popt,'ldir',$GLOBALS::CORPUS_H->{$corp}{list_dir},
			   "<dir>\t: lists root directory of the defined corpus\n\t\t ");
  
  # Speech data format
  my @corpuslist = keys %{$GLOBALS::CORPUS_H};
  my %fh = ();
  foreach (@corpuslist) {
    if (defined($GLOBALS::CORPUS_H->{$_}{speech_data_format}) ) {
      $fh{$GLOBALS::CORPUS_H->{$_}{speech_data_format}} = undef;
    }
  }
  my $vformat = join(' ',keys %fh);
  $opt->define($popt,'format',$GLOBALS::CORPUS_H->{$corp}{speech_data_format},
			   "<form>\t: format of input speech file. Valid formats are: $vformat\n\t\t ");
  
  # Optional loc file specifying the cdrom name where an id can be found. 
  # This is made because of the different naming conventions of our cdroms...
  $opt->define($popt,'loc',$opt->{ldir}{string} . $corp . '_loc.list',
			   "<loc>\t: list file associating IDs to cdrom names\n\t\t ");
  $opt->{loc}{Root} = ();
  
  # Optional channel file
  $opt->define($popt,'chan',$opt->{ldir}{string} . $corp . '_chan.list',
			   "<cha>\t: list file associating channel to speaker IDs\n\t\t ");
  $opt->{chan}{Id} = ();
}

#----------------------------------------------------------------------
# MAIN
#----------------------------------------------------------------------

# Initialisations
my $glob = new GLOBALS;

$glob->{GLOBALS_PATH} = "$ENV{HOME}/db/";
$glob->{DEF_GLOBALS} =  $glob->{GLOBALS_PATH} . 'deu/globals.pl';
$glob->requireglob;

my @corpuslist = keys %{$GLOBALS::CORPUS_H};
my $CORPUS = $corpuslist[0];
$::DONE_MESSAGE = 'DONE';

# Define the set of options 

my $OptL = new OPTIONS;

# Commands
$OptL->list(Do => 0,  Usage => "display list of corpuses available for default language");
$OptL->noswab(Do =>0, Usage => "do not swap 16 bit words in speech file");

# Extensions
$OptL->enist(string => 'nist', Usage => "extension of NIST speech files");
$OptL->esp(string => '(defined in globals.pl)', Usage => "original speech files extension");
$OptL->elist(string => '.full', Usage => "file list extension");

# Others
$OptL->dsound(string => '/cdromserv/views_pc/',Usage => "<dir>\t: root directory for speech sound files");
$OptL->groot(string => $GLOBALS::GLOBALS_PATH, Usage => "<dir>\t: global path");
$OptL->lang(string => $GLOBALS::DBLANG, Usage => "<Iso3>\t: language three letters code from Iso 3166/2T");
$OptL->lname(string => '', Usage => "<name>\t: name of list");
$OptL->rpat(string => '',Usage =>  "<pat>\t: perl root pattern for file search. This pattern will\n" .
			"\t\t  be substituted from the original root path");
$OptL->snist(string => 16000, Usage => "<freq>\t: sampling frequency of NIST speech files");

# Corpus and database dependent options
define_options($CORPUS,$OptL,undef);

# Remember initial settings
my $InitOptL = new OPTIONS;
$InitOptL->copy($OptL);


#----------------------------------------------------------------------
# Command processing
#----------------------------------------------------------------------
$OptL->GetOpt || die "Check your options\n";

# Check arguments

# Check the language and reload globals if necessary
if ($OptL->{groot}{string} ne $GLOBALS::GLOBALS_PATH or 
    $OptL->{lang}{string} ne $GLOBALS::DBLANG) {
  $glob->{GLOBALS_PATH} = $OptL->{groot}{string};
  $glob->{DEF_GLOBALS}  = $OptL->{groot}{string}. $OptL->{lang}{string} . '/globals.pl';
  $glob->requireglob;
}
# Extract new corpus list
@corpuslist = keys %{$GLOBALS::CORPUS_H};

# Should we list available corpuses ?
if ($OptL->{list}{Do}) {
  # List of available corpuses
  warn "Available corpus for language $OptL->{lang}{string}: @corpuslist\n";
  exit 0;
}

# Do we have any corpus to treat ?
if (!($CORPUS=$ARGV[0])) {
  warn "Which corpus should be treated ?\n";
  $CORPUS = $corpuslist[0];
  define_options($CORPUS,$OptL,$InitOptL);
  $OptL->Usage('corpus','');
}
else {
  if (exists($GLOBALS::CORPUS_H->{$CORPUS})) {
    define_options($CORPUS,$OptL,$InitOptL);
    warn "generating $CORPUS for language: $OptL->{lang}{string}\n";
  } else { die "corpus $CORPUS unknown for language $OptL->{lang}{string}\n";}
}

#------------------------------------------------------------------------------------
# Main
#------------------------------------------------------------------------------------

# Generate list of SAM extensions for the speech files of the choosen language
if (!defined($GLOBALS::CORPUS_H->{$CORPUS}{ext_list}) ){
  $GLOBALS::CORPUS_H->{$CORPUS}{ext_list} = GenSAMExtList($OptL->{lang}{string},'Samples');
}
# Extract some infos
my @lists = sort @{$GLOBALS::CORPUS_H->{$CORPUS}{db_dirs}};
if ($OptL->{lname}{string} ne '') {@lists = ($OptL->{lname}{string});}
warn 'search paths: ', join(' ',@lists), "\n";
my $list_dir = $OptL->{ldir}{string};
warn "list dir: $list_dir\n";
my $ext_list = [$OptL->{esp}{string}];
if ($OptL->{esp}{string} =~ m/\(.*\)/) {$ext_list = $GLOBALS::CORPUS_H->{$CORPUS}{ext_list};}
warn 'ext. list: ', join(" ",@{$ext_list}), "\n";

# read the association file for speakerids to cdrom names
$OptL->LocationRead;

# read the channel file for speakerids
$OptL->ChannelRead;

# Test the existence of list directory
if (-d $list_dir) {
  warn "Converting speech files from lists in $list_dir\n";
  
  # Perform the treatment for each list
  foreach ( @lists ) {
    warn "Process list file: $list_dir$_\n";
    ProcessList($OptL,$_,$ext_list,$CORPUS);
  }
} else {die "Error: List directory $list_dir not existent !!\n";}


__END__

=head1 COMMANDS

The following commands are defined:

=over 12

=item -list	

display list of corpuses available for default language

=item -noswab	

do not swap 16 bit words in speech file

=back

=head1 OPTIONS

The following options are defined:

=over 12

=item -chan I<cha>	

  list file associating channel to speaker IDs

=item -dbdir I<dir>	

  speech database directory
  (default: /speech/db/)

=item -dsound I<dir>	

  root directory for speech sound files
  (default: /cdromserv/views_pc/)

=item -elist I<ext>	

  file list extension
  (default: .full)

=item -enist I<ext>	

  extension of NIST speech files
  (default: nist)

=item -esp I<ext>	

  original speech files extension
  (default: (defined in globals.pl))

=item -format I<form>	

  format of input speech file. Valid formats are: raw

=item -groot I<dir>	

  global path
  (default: /home/giron1/db/)

=item -lang I<Iso3>	

  language three letters code from Iso 3166/2T
  (default: deu)

=item -ldir I<dir>	

  lists root directory of the defined corpus

=item -lname I<name>	

  name of list

=item -loc I<loc>	

  list file associating IDs to cdrom names

=item -rpat I<pat>	

  perl root pattern for file search. This pattern will
  be substituted from the original root path
  (default: )

=item -samp I<freq>	

  sampling frequency of corpus speech files
  (default: 48000)

=item -snist I<freq>	

 sampling frequency of NIST speech files
 (default: 16000)

=back
